Tracks 1-48

Col Graphs

PBs by Week

Average Improvement by Week

Cumulative Improvement

Col Violin

PB Time Distributions, Feb 01, 2022 - Present

Tracks 49-96

Col Graphs

PB Count by Week

Average Improvement by Week

Cumulative Improvement

Col Violin

PB Time Distributions, Feb 01, 2022 - Present

Tables

Col Table

Current PBs Tracks 1-48

Track PB Date PB WR Diff
Mushroom Mario Kart Stadium 2022-08-14 1M 45.158S 10.446
Water Park 2022-08-14 1M 48.01S 7.826
Sweet Sweet Canyon 2022-08-17 1M 55.716S 6.871
Thwomp Ruins 2022-07-23 1M 56.663S 7.688
Flower Mario Circuit 2022-08-17 1M 53.422S 8.091
Toad Harbor 2022-08-17 2M 12.859S 10.521
Twisted Mansion 2022-08-14 2M 4.604S 10.144
Shy Guy Falls 2022-08-15 2M 7.893S 11.685
Star Sunshine Airport 2022-08-15 2M 9.102S 10.999
Dolphin Shoals 2022-08-15 2M 5.647S 12.241
Electrodrome 2022-08-15 2M 7.453S 11.488
Mount Wario 2022-08-31 1M 51.45S 9.467
Special Cloudtop Cruise 2022-08-17 2M 11.339S 11.553
Bone-Dry Dunes 2022-09-11 1M 58.815S 11.903
Bowser’s Castle 2022-08-17 2M 9.397S 10.402
Rainbow Road 2022-08-17 2M 11.477S 12.163
Shell Wii Moo Moo Meadows 2022-08-17 1M 31.958S 7.498
GBA Mario Circuit 2022-09-02 1M 31.131S 7.294
DS Cheep Cheep Beach 2022-08-17 1M 56.547S 9.499
N64 Toad’s Turnpike 2022-08-17 1M 53.609S 7.236
Banana GCN Dry Dry Desert 2022-09-02 2M 5.475S 11.851
SNES Donut Plains 3 2022-08-31 1M 23.495S 10.662
N64 Royal Raceway 2022-08-17 2M 7.086S 11.432
3DS DK Jungle 2022-08-14 2M 12.646S 11.470
Leaf DS Wario Stadium 2022-08-14 2M 3.195S 12.201
GCN Sherbet Land 2022-09-02 1M 58.752S 11.754
3DS Music Park 2022-07-03 2M 3.551S 12.572
N64 Yoshi Valley 2022-08-14 2M 6.218S 7.787
Lightning DS Tick-Tock Clock 2022-08-14 1M 54.861S 12.516
3DS Piranha Plant Slide 2022-08-14 2M 9.61S 10.386
Wii Grumble Volcano 2022-08-19 2M 4.488S 11.300
N64 Rainbow Road 2022-08-14 1M 26.372S 6.383
Egg GCN Yoshi Circuit 2022-08-14 1M 54.189S 12.051
Excitebike Arena 2022-08-18 1M 50.425S 10.438
Dragon Driftway 2022-08-19 1M 50.088S 9.468
Mute City 2022-09-11 1M 59.807S 8.529
Triforce Wii Wario’s Gold Mine 2022-08-15 2M 10.678S 8.136
SNES Rainbow Road 2022-08-18 1M 34.172S 7.904
Ice Ice Outpost 2022-09-05 1M 55.067S 9.851
Hyrule Circuit 2022-08-18 1M 57.341S 9.666
Crossing GCN Baby Park 2022-08-15 1M 10.013S 7.871
GBA Cheese Land 2022-09-02 1M 54.367S 12.431
Wild Woods 2022-08-18 1M 54.225S 8.212
Animal Crossing 2022-08-17 1M 45.158S 8.456
Bell 3DS Neo Bowser City 2022-09-03 1M 54.095S 11.524
GBA Ribbon Road 2022-08-14 1M 54.584S 9.197
Super Bell Subway 2022-08-15 1M 51.517S 11.027
Big Blue 2022-08-14 1M 32.2S 8.617

Tracks 49-96

Track PB Date PB WR Diff
Golden Dash Tour Paris Promenade 2022-08-14 1M 58.784S 8.417
3DS Toad Circuit 2022-08-14 1M 28.148S 7.731
N64 Choco Mountain 2022-08-14 2M 2.045S 9.375
Wii Coconut Mall 2022-08-14 1M 51.731S 9.964
Lucky Cat Tour Tokyo Blur 2022-08-14 1M 32.191S 6.361
DS Shroom Ridge 2022-08-14 1M 55.359S 10.367
GBA Sky Garden 2022-08-14 1M 36.277S 9.054
Tour Ninja Hideaway 2022-06-19 2M 2.145S 9.431
Turnip Tour New York Minute 2022-08-14 1M 32.608S 9.488
SNES Mario Circuit 3 2022-08-14 1M 43.171S 12.007
N64 Kalimari Desert 2022-08-14 1M 39.011S 9.507
DS Waluigi Pinball 2022-08-06 2M 30.8S 11.305
Propeller Tour Sydney Sprint 2022-08-11 2M 11.751S 10.917
GBA Snow Land 2022-08-06 1M 38.503S 11.622
Wii Mushroom Gorge 2022-08-06 1M 41.276S 13.592
Sky-High Sundae 2022-08-04 2M 7.354S 11.817

All Records

All Records Tracks 1-48

Tracks 49-96

---
title: "Mario Kart Time Trial PBs"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    theme: sandstone
    navbar:
      - { title: "Speedruns", href: "sr.html", align: right}
      - { icon: "fas fa-home", href: "index.html", align: right}
    favicon: blueshell.png
    source_code: embed
---

<script>
$(document).ready(function(){
    $('[data-toggle="popover"]').popover(); 
});
</script>

```{r lib}
library(tidyverse)
library(rvest)
library(plotly)
library(lubridate)
library(knitr)
library(kableExtra)
library(DT)
library(emojifont)
```

```{r scrapeWRs}
# Use rvest to scrape WR leaderboard
html <- read_html("http://www.mkwrs.com/mk8dx/wrs.php")

wr0 <- html %>% html_elements(".wr") %>% html_table() %>% .[[1]] %>% 
  rename_with(tolower, everything()) %>% 
  select(track, total = `time+video`, player, date) %>% 
  filter(track != "Total:") %>% 
  mutate(total = str_replace_all(total, "'", ":"),
         total = str_replace_all(total, "\"", "."))

# Labels for violin plot (player name & date). Supports ties.
wr_label <- wr0 %>%
  group_by(track) %>%
  mutate(label = paste0(player, " (", date, ")"),
         n = row_number()) %>%
  ungroup() %>%
  select(-c(player, date)) %>%
  pivot_wider(names_from = n,
              values_from = label,
              names_prefix = "lab_") %>%
  unite("label",
        starts_with("lab_"),
        sep = " &<br>",
        na.rm = TRUE) %>% 
  mutate(label = paste0("<b>", total, "<b><br>", label)) %>% 
  select(-total)

# Use to join w/ other data & compare
wr <- wr0 %>% 
  select(track, WR_total = total) %>%
  mutate(WR_total = ms(WR_total)) %>% 
  distinct()

rm(html, wr0)
```


```{r import}
abr <- read_csv("_data/abr.csv") %>%
  mutate(track = ifelse(!is.na(source), paste(source, short), short)) %>%
  select(trkNO, trk, track, cup, type) %>%
  mutate(track = fct_inorder(track),
         cup = fct_inorder(cup))

ctrk <- abr$track
ccup <- unique(abr$cup)

tt <- read_csv("_data/time-trials.csv",
               col_types = cols(total = "c")) %>%
  filter(cc == 150) %>%
  left_join(abr, by = "trk") %>%
  select(-c(cc, trk, starts_with("lap"))) %>%
  mutate(
    total = ms(total),
    yr = year(date),
    mth = month(date),
    wk = week(date) - 4,
    day = day(date),
    hour = hour(time),
    min = minute(time),
    dt = make_datetime(
      year = yr,
      month = mth,
      day = day,
      hour = hour,
      min = min
    )
  ) %>%
  select(trkNO:type, total, date, dt, yr, wk) %>%
  arrange(track, dt) %>%
  group_by(track) %>%
  mutate(
    improve = round(as.double(lag(total) - total, units = "secs"), 3),
    improve = replace_na(improve, 0),
    cumsum = cumsum(improve)
  ) %>%
  ungroup()

tt_PB <- tt %>%
  select(track, total, dt) %>%
  group_by(track) %>%
  slice_max(dt) %>%
  ungroup() %>%
  left_join(wr, by = "track") %>%
  mutate(WR_diff = round(as.double(total - WR_total, units = "secs"), 3))

tt_all <- tt %>%
  left_join(tt_PB, by = c("track", "total", "dt")) %>%
  mutate(track = factor(track, levels = ctrk))

tt_tbl <- tt_all %>%
  select(trkNO, cup, track, date, total, improve, WR_total, WR_diff)

wk_now <- as_tibble_col(1:(week(today()) - 4)) 
```

# Tracks 1-48 

```{r}
tt_48 <- tt_all %>% 
  filter(trkNO < 49) %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup()
```

## Col Graphs

```{r}
tt_48_wk <- tt_48 %>% 
  group_by(wk) %>% 
  summarise(mean = mean(improve), n = n()) %>% 
  ungroup() %>% 
  full_join(wk_now, by = c("wk" = "value")) %>% 
  mutate(across(2:3, ~ replace_na(.x, 0))) %>% 
  arrange(wk)
```

### PBs by Week

```{r}
gg_48_wk <- tt_48_wk %>% 
  ggplot() +
  geom_line(aes(x=wk, y=n)) +
  theme_minimal() +
  labs(y = "PBs",
       x = "Week")

ggplotly(gg_48_wk)
```

### Average Improvement by Week

```{r}
gg_48_wk_2 <- tt_48_wk %>% 
  ggplot(aes(x=wk, y=mean)) +
  geom_line() +
  theme_minimal() + 
  labs(x = "Week",
       y = "Average Improvement (secs)")

ggplotly(gg_48_wk_2)
```

### Cumulative Improvement

```{r}
gg_cts_48 <- tt_48 %>% 
  filter(improve != 0) %>% 
  arrange(dt) %>% 
  mutate(cumsum = cumsum(improve)) %>% 
  ggplot(aes(x=dt, y=cumsum)) +
  geom_step() +
  theme_minimal() +
  labs(x="", y="Cumulative Improvement (secs)") +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none")

ggplotly(gg_cts_48)
```

## Col Violin

### PB Time Distributions, Feb 01, 2022 - Present

```{r violin48, fig.height=10}
gg_48 <- tt_48 %>% 
  filter(track != "GCN Baby Park") %>% 
  ggplot(aes(factor(track), total)) +
  geom_violin(draw_quantiles = 0.5, 
              scale = "width",
              aes(fill = sd, color=sd),
              alpha = .7) + 
  stat_summary(fun = "median", geom = "point", size = .4) +
  geom_text(aes(factor(track), WR_total), 
            label = emoji("star"), 
            family = 'EmojiOne',
            size = 2) +
  scale_fill_gradient(low = "darkcyan", high = "plum") +
  scale_color_gradient(low = "darkcyan", high = "plum") +
  scale_y_time() +
  scale_x_discrete(limits = rev) +
  labs(x = "",
       y = "PB Time") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 0.98,
                                   vjust = 0.9),
        axis.text = element_text(size = 8),
        axis.ticks = element_line(size = .2),
        panel.grid = element_line(size = .2),
        panel.border = element_rect(fill = NA, size = .2),
        legend.position = "none")

ggplotly(gg_48)
```

# Tracks 49-96 

```{r}
tt_96 <- tt_all %>% 
  filter(trkNO > 48) %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup()
```

## Col Graphs {data-width=330}

```{r}
tt_96_wk <- tt_96 %>% 
  group_by(wk) %>% 
  summarise(mean = mean(improve), n = n()) %>% 
  ungroup() %>% 
  full_join(wk_now, by = c("wk" = "value")) %>% 
  mutate(across(2:3, ~ replace_na(.x, 0))) %>% 
  arrange(wk)
```

### PB Count by Week

```{r}
gg_96_wk <- tt_96_wk %>% 
  ggplot() +
  geom_line(aes(x=wk, y=n)) +
  theme_minimal() +
  labs(y = "PBs",
       x = "")

ggplotly(gg_96_wk)
```

### Average Improvement by Week

```{r}
gg_96_wk_2 <- tt_96_wk %>% 
  ggplot(aes(x=wk, y=mean)) +
  geom_line() +
  theme_minimal() + 
  labs(x = "",
       y = "Improvement (secs)")

ggplotly(gg_96_wk_2)
```

### Cumulative Improvement

```{r}
gg_cts_96 <- tt_96 %>% 
  filter(improve != 0) %>% 
  arrange(dt) %>% 
  mutate(cumsum = cumsum(improve)) %>% 
  ggplot(aes(x=dt, y=cumsum)) +
  geom_step() +
  theme_minimal() +
  labs(x="", y="Improvement (secs)") +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none")

ggplotly(gg_cts_96)
```

## Col Violin

### PB Time Distributions, Feb 01, 2022 - Present

```{r violin96, fig.height=10}
gg_96 <- tt_96 %>% 
  filter(track != "GCN Baby Park") %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup() %>% 
  ggplot(aes(factor(track), total)) +
  geom_violin(draw_quantiles = 0.5, 
              scale = "width",
              aes(fill = sd, color=sd),
              alpha = .7) + 
  stat_summary(fun = "median", geom = "point", size = .4) + 
  geom_text(aes(factor(track), WR_total), 
            label = emoji("star"), 
            family = 'EmojiOne',
            size = 2) +
  scale_fill_gradient(low = "darkcyan", high = "plum") +
  scale_color_gradient(low = "darkcyan", high = "plum") +
  scale_y_time() +
  scale_x_discrete(limits = rev) +
  labs(x = "",
       y = "PB Time") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 0.98,
                                   vjust = 0.9),
        axis.text = element_text(size = 8),
        axis.ticks = element_line(size = .2),
        panel.grid = element_line(size = .2),
        panel.border = element_rect(fill = NA, size = .2),
        legend.position = "none")

ggplotly(gg_96)
```

# Tables {data-orientation=columns}

## Col Table {.tabset data-width=500}

```{r}
tt_tbl_48 <- tt_tbl %>% 
  filter(trkNO < 49) %>% 
  select(-trkNO)

PB_tbl_48 <- tt_tbl_48 %>% 
  filter(!is.na(WR_total)) %>% 
  select(-improve)

tt_tbl_96 <- tt_tbl %>% 
  filter(trkNO > 48) %>% 
  select(-trkNO)

PB_tbl_96 <- tt_tbl_96 %>% 
  filter(!is.na(WR_total)) %>% 
  select(-improve)
```

### Current PBs Tracks 1-48 

```{r}
PB_tbl_48 %>% 
  kbl(
    col.names = c(" ", "Track", "PB Date", "PB", "WR", "WR Diff"),
    align = "c",
    escape = FALSE,
    longtable = TRUE
  ) %>% 
  kable_styling(full_width = TRUE) %>%
  column_spec(column = 1,
              extra_css = 'transform: rotate(270deg);') %>%
  column_spec(3:4,
              extra_css = 'font-size: 80%;') %>%
  column_spec(
    6,
    color = "white",
    background = spec_color(
      PB_tbl_48$WR_diff,
      begin = 0.3,
      end = 0.7,
      alpha = 0.7,
      option = "A"
    ),
    popover = paste0("WR: ", PB_tbl_48$WR_total)
  ) %>%
  remove_column(5) %>%
  collapse_rows(columns = 1,
                row_group_label_position = 'stack') %>%
  row_spec(0, align = "c")
```

### Tracks 49-96

```{r}
PB_tbl_96 %>% 
  kbl(
    col.names = c(" ", "Track", "PB Date", "PB", "WR", "WR Diff"),
    align = "c",
    escape = FALSE,
    longtable = TRUE
  ) %>% 
  kable_styling(full_width = TRUE) %>%
  column_spec(column = 1,
              extra_css = 'transform: rotate(270deg);') %>%
  column_spec(3:4,
              extra_css = 'font-size: 80%;') %>%
  column_spec(
    6,
    color = "white",
    background = spec_color(
      PB_tbl_96$WR_diff,
      begin = 0.3,
      end = 0.7,
      alpha = 0.7,
      option = "A"
    ),
    popover = paste0("WR: ", PB_tbl_96$WR_total)
  ) %>%
  remove_column(5) %>%
  collapse_rows(columns = 1,
                row_group_label_position = 'stack') %>%
  row_spec(0, align = "c")
```

## All Records {.tabset}

### All Records Tracks 1-48 

```{r}
tt_tbl_48 %>%
  select(-WR_total) %>%
  mutate(total = paste(total),
         improve = ifelse(improve == 0, NA, improve)) %>%
  arrange(desc(WR_diff)) %>%
  datatable(
    rownames = FALSE,
    colnames = c("Cup", "Track", "PB Date", "PB",
                 "Improvement", "WR Diff"),
    filter = 'top',
    options = list(pageLength = 48,
                   autoWidth = TRUE,
                   columnDefs = list(
                     list(className = 'dt-center', targets = 0:3)
                   ))
  ) %>%
  formatStyle(3:6, `font-size` = '80%') 
```

### Tracks 49-96

```{r}
tt_tbl_96 %>%
  select(-WR_total) %>%
  mutate(total = paste(total),
         improve = ifelse(improve == 0, NA, improve)) %>%
  arrange(desc(WR_diff)) %>%
  datatable(
    rownames = FALSE,
    colnames = c("Cup", "Track", "PB Date", "PB",
                 "Improvement", "WR Diff"),
    filter = 'top',
    options = list(pageLength = 48,
                   autoWidth = TRUE,
                   columnDefs = list(
                     list(className = 'dt-center', targets = 0:3)
                   ))
  ) %>%
  formatStyle(3:6, `font-size` = '80%') 
```